perm filename SMPLSF.F4[M11,LCS] blob sn#519434 filedate 1980-06-24 generic text, type T, neo UTF8
00100	C***** SMPLS.F4  (CALLED 'WAVES' AT IRCAM)**************
00200	C DISPLAYS SAMPLES (WAVES) OF .DAT FILES PRODUCED BY PASS3, MUSIC5.
00300	
00400		DIMENSION I(512),ILI(1),L(131)
00500	CXX	DOUBLE PRECISION NM,NMX,NMZ,ITST,NBLA
00600	   	INTEGER*4 NM,NMX,NMZ,ITST,NBLA
00700		EQUIVALENCE (I1,I),(I2,I(2)),(I3,I(3)),(AMP,MAXAMP)
00800		DATA NBLA/'    '/,IBLA/' '/,IAST/'*'/,ITST/'TEST'/
00900		DATA IFF/'F'/,NMX/'    '/
01000	1212	IDEV=5   
01100	C***** 5=TTY, 1=DSK
01200		LCNT=20
01300		LEND=130
01400		KOLD=130
01500	C  JUNPAC IS FOR OTHER THAN 12-BIT SMPLS.  NOT USED YET.
01600		JUNPAC=0
01700		JNCX=0
01800		KCNT=0
01900		ICNT=0
02000		TYPE 30
02100		ACCEPT 31,NM
02200	CC	IF(NM.EQ.NBLA)NM=NMX
02300		IF(NM.EQ.NBLA)NM=ITST
02400		NMX=NM
02500	CC4000	IF(NM.EQ.NMZ)NM=ITST
02600		CALL IFILE(21,NM)
02700	CPDP11    	CALL OPEN(21,NM,0,'RDO',,,'UNF')
02800	C////	KBIT=3
02900	C////	IAMP=131000
03000	C////	DUR=ISMPLS/DUR
03100	C**** NEXT 2 FOR PDP11 VERSION (12BIT ONLY NOW)
03200		IAMP=2080
03300		JAMP=51
03400		ISMPLS=32000
03500	
03600		K40=40
03700		IFLIP=0
03800		NCH=1
03900		IF(NCHNS.LT.2)GO TO 33
04000		TYPE 34
04100	34	FORMAT(' TYPE CHNL NUM.  '$)
04200		IFLIP=-1
04300		ACCEPT 1,NCH
04400		IF(NCH.EQ.0)NCH=1
04500		IF(NCH.NE.1)IFLIP=-IFLIP
04600	33	TYPE 47
04700		ACCEPT 46,INCX
04800		IF(INCX.EQ.0)INCX=1
04900		TYPE 40
05000		F=0
05100		ACCEPT 46,ISKP,LAST,NORM
05200	C***************************************************************
05300	C************* YOU MUST PUT COMMAS BETWEEN INPUT NUMBERS *******
05400	C***************************************************************
05500		IF(LAST.EQ.0)LAST = ISKP+100
05600	C  IF NO NUMBER IS TYPED FOR 'LAST' ISKP+100 SAMPLES ARE DISPLAYED.
05700		IF(LAST.LT.ISKP)LAST=ISKP+LAST
05800		IF(LAST.GT.ISMPLS)LAST=ISMPLS
05900		IF(ISKP.NE.0)ISKP=ISKP-1
06000	50	FORMAT(' <CR>=DPY   F=TO A FILE '$)
06100	51	FORMAT(' <CR>=LPT FORMAT     D=DPY FORMAT '$)
06200		TYPE 50
06300		ACCEPT 31,IDSK
06400		IF(IDSK.NE.IFF)GO TO 45
06500		TYPE 51
06600		ACCEPT 31,IFL
06700		CALL OFILE(1,'SMPLS')
06800	CPDP11   	CALL OPEN(1,'SMPLS',0,'NEW')
06900	CC	IF(IDSK.NE.IFF)GO TO 144
07000		LCNT=50
07100		TYPE 44
07200	CC44	FORMAT(/' WRITING FILE: SMPLS.DAT',/,
07300	44	FORMAT(/' WRITING FILE: SMPLS.DAT',/)
07400	CC	1 ' TO STOP: TYPE <CALL>, F <CR>')
07500	144	IDEV=1  
07600	C** FOR DSK OUTPUT.
07700	40	FORMAT(' TYPE SAMPLE NUM.1, NUM2  '$)
07800	1	FORMAT(8I9)
07900	46	FORMAT(8I)
08000	31	FORMAT(2A4)
08100	30	FORMAT(' TYPE FILE NAME  '$)
08200	5	FORMAT(1X80A1)
08300	CC	JAMP=51
08400	CC	IF(JUNPAC.NE.0)JAMP=1637
08500	45	IF(IFL.NE.IBLA)GO TO 2
08600	CC45	IF(IFL.NE.IBLA)GO TO 102
08700		JAMP=32
08800	CC	IF(JUNPAC.NE.0)JAMP=1007
08900		K40=65
09000		GO TO 2
09100	CC102	IF(JUNPAC.NE.0)GO TO 2
09200	CC202	IF(MAXAMP.GT.1900)GO TO 2
09300	C////	IF(K.NE.'N')GO TO 2
09400	C////	JAMP=IAMP/40
09500	C////	DO 3 K=1,1024
09600	2	READ(21)I
09700		DO 3 JJ=1,512
09800	
09900		IFLIP=-IFLIP
10000		ICNT=ICNT+1    
10100		  IF(ICNT.LT.ISKP)GO TO 3
10200		IF(ICNT.GT.LAST)GO TO 41 
10300		IF(IFLIP)GO TO 3  
10400	C****** STEREO FLIP-FLOP
10500		JNCX=JNCX+1
10600		IF(JNCX.NE.INCX)GO TO 3
10700		JNCX=0
10800	99	KX=I(JJ)
10900		KK=(KX+IAMP)/JAMP  
11000		KF=-1
11100		KZZ=6
11200	CC	IF(MOD(ICNT,100).NE.0)GO TO 997
11300		KCNT=KCNT+1
11400		IF(KCNT.LT.LCNT)GO TO 997
11500		KCNT=0
11600		KF=0 
11700		KZZ=14
11800	997	IF(KOLD.EQ.KK)GO TO 777
11900		K80=KOLD
12000		IF(KK.GT.KOLD)K80=KK
12100		IF(KK.GE.LEND)LEND=K40 
12200		DO 4 KM=6,LEND
12300	4	L(KM)=IBLA
12400	400	LEND=KK
12500		INC=-1
12600		IF(KK.GE.K40)INC=-INC
12700		DO 999 KZ=K40,KK,INC
12800	999	L(KZ)=IAST
12900	998	KZ=KK  
13000		KOLD=KK
13100		IF (KZ.GE.K40)GO TO 777
13200		KZ=K40
13300	777	IF(KF)GO TO 7
13400		WRITE(IDEV,106)NMX,ICNT,(L(NN),NN=11,KZ)
13500		IF(IDEV.EQ.1)TYPE 106,NMX,ICNT  
13600	C***TELL HOW FAR ALONG WE ARE.
13700		GO TO 3
13800	CC7	IF(JUNPAC.NE.0)GO TO 778
13900	7	WRITE(IDEV,1105)KX,(L(NN),NN=6,KZ)
14000		GO TO 3
14100	778	WRITE(IDEV,105)KX,(L(NN),NN=9,KZ)
14200	3	CONTINUE 
14300		GO TO 2
14400	CXX41	CALL CLOSE(21)
14500	41	IF(IDEV.EQ.1)END FILE(1)
14600	CPDα
14650	
14675	
14687	
14693	
14696	CPDP11 41	GO TO 1212
14700	47	FORMAT(' INCREMENT = '$)
14800	105	FORMAT(I9,122A1)
14900	1105	FORMAT(I6,124A1)
15000	106	FORMAT(1XA4,I6,120A1)
15100		END